Loadstar 90/090.d81/starry night.src

Commodore BASIC | 1991-01-01 | 7.3 KB | 420 lines

1 rem 'pal' assembler format source
2 rem setup to assemble object code to a disk file
10 open2,8,1,"@0:starry night"
20 sys700
30 .opt o2
40 v3 = $d40e
50 random = $d41b
60 table = $4000
70 *= $0801
80 .byte 11,8,10,0,158,50,48,54,49
90 .byte 0,0,0
95 lda #0
96 sta $d418
100 tsx
110 stx stkpntr
120 jsr randomon ;v3 activate
130 jsr setirq
140 start lda #55 ;--- ----
150 sta $01
160 lda #11
170 sta $d020
180 lda #0
190 sta irqflg
200 sta moveflg ;(stars
210 sta $d021
220 lda #21
230 sta $d018
240 lda #27
250 lda $d011
260 and #%11011111
270 sta $d011
280 sta $d011
290 ldx stkpntr
300 txs
310 jsr delay2
320 lda #$20
330 sta a2+2
340 jsr print
350 .asc "[147]_       [129]s t a r r y    n i g h t__"
390 .asc "   crsr up  increase number of stars_"
400 .asc "   crsr dn  decrease number of stars_"
410 .asc "_   [159]number of stars now set at @"
420 jsr savepos
430 jsr shownumb
440 jsr print :.byte 13,13
450 .asc "   f1  see stars normal_"
460 .asc "   f7  see stars changing positons_"
462 .asc "   q   quit to loadstar__"
470 .asc "   [159]while the stars are showing:__"
480 .asc "   crsr up  increase twinkle speed_"
490 .asc "   crsr dn  decrease twinkle speed_"
500 .asc "   return   returns to this screen__"
502 .asc "  [155]                                    [146]_"
503 .asc "        s t a r r y    n i g h t      [146]_"
504 .asc "            by john augustine         [146]_"
505 .asc "       v1.0 (c) by softdisk, inc.     [146]_"
506 .asc "      subscriptions: 1-800-831-2694   [146]_"
507 .asc "                                      [146]@"
510 kybd jsr inkey ;--- ---
515 cmp #"q"
517 bne *+5
518 jmp qw0
520 cmp #"[145]"
530 bne *+5
540 jmp crsrup
550 cmp #""
560 bne *+5
570 jmp crsrdn
580 cmp #133 ;f1
590 beq c6
600 cmp #136 ;f7
610 bne kybd
620 sta moveflg ;un0
630 c6 lda #54
640 sta $01 ;bas out
650 sta irqflg ;un0
660 ldx #0
670 stx onflg
680 lda #%00010000
690 a1 sta $0400,x ;blk&wht 'color'
700 sta $0500,x
710 sta $0600,x
720 sta $0700,x
730 inx
740 bne a1
750 lda $d011
760 ora #%00100000
770 sta $d011 ;bit map
780 lda #%00011000
790 sta $d018 ;pic data at $2000
800 ldx #0
810 txa
820 a2 sta $2000,x ;clr bitmap
830 inx
840 bne a2
850 inc a2+2
860 ldy a2+2
870 cpy #$40
880 bne a2
890 jsr setfb ;- - -stars on, one pass
900 a4 lda cntnumb
910 sta cntdwn
920 ldy #0
930 a6 lda #$20 ;$20xx (xx random
940 sta $fe
950 a5 lda random ;0 - 255
960 sta $fd
970 sta ($fb),y ;(for turnin off stars
980 jsr fbinc
990 lda seed ;(irq shifts on bit
1000 sta mask ;prevnt cng by irq
1010 eor #255 ;revrs bits
1020 sta ($fb),y
1030 jsr fbinc
1040 lda ($fd),y
1050 eor mask
1060 sta ($fd),y ;star on
1070 jsr delay2
1080 inc $fe ;nx pg (+256 bytes
1090 lda $fe
1100 cmp #$40
1110 bne a5
1120 dec cntdwn
1130 bne a6
1140 lda moveflg ;which star rtn
1150 beq c4
1160 jmp a8
1170 c4 lda cntnumb ;- - twinkle rtn -
1180 sta cntdwn
1190 jsr setfb
1200 ldy #0
1210 c3 lda #$20 ;- - -
1220 sta $41 ;$20xx (xx from table
1230 c5 lda ($fb),y ;turn off a star
1240 sta $40
1250 iny
1260 lda ($fb),y ;get off mask
1270 dey
1280 ldx onflg ;turn star on or off
1290 beq c1 ;turn it off
1300 eor #255
1310 ora ($40),y
1320 sta ($40),y ;star on agn
1330 bne c2 ;un
1340 c1 and ($40),y
1350 sta ($40),y ;star off
1360 c2 jsr fbinc
1370 jsr fbinc
1380 lda $02 ;(irq keybd
1390 cmp #13 ;abrt
1400 bne *+5
1410 jmp start
1420 jsr delay
1430 inc $41 ;nx pg
1440 lda $41
1450 cmp #$40 ;$4000 end of bitmap
1460 bne c5
1470 lda onflg
1480 eor #40
1490 sta onflg
1500 dec cntdwn
1510 bne c3
1520 beq c4
1530 a8 lda cntnumb ;------move & twnkl
1540 sta cntdwn
1550 jsr setfb
1560 ldy #0
1570 a7 lda #$20 ;- - -
1580 sta $41 ;$20xx bitmap
1590 sta $fe
1600 a9 lda ($fb),y ;turn off a star
1610 sta $40
1620 iny
1630 lda ($fb),y ;get off mask
1640 dey
1650 and ($40),y
1660 sta ($40),y ;star off
1670 lda random ;0 - 255
1680 sta $fd
1690 sta ($fb),y ;stars off nx pass
1700 jsr fbinc
1710 lda seed ;(irq shifts on bit
1720 sta mask ;prevnt cng by irq
1730 eor #255 ;revrs bits
1740 sta ($fb),y
1750 jsr fbinc
1760 lda ($fd),y
1770 eor mask
1780 sta ($fd),y
1790 lda $02 ;(irq keybd
1800 cmp #13 ;abrt
1810 bne *+5
1820 jmp start
1830 jsr delay
1840 inc $fe ;nx pg (+256 bytes
1850 inc $41 ;nx pg
1860 lda $fe
1870 cmp #$40
1880 bne a9
1890 dec cntdwn
1900 bne a7
1910 beq a8
1920 randomon lda #240 ;------
1930 sta v3+1
1940 lda #%10000001 ;noise/gate
1950 sta v3+4
1960 rts
1970 setfb lda #<table ;-------
1980 sta $fb
1990 lda #>table
2000 sta $fc
2010 rts
2020 fbinc inc $fb ;------
2030 bne *+4
2040 inc $fc
2050 rts
2060 setirq sei ;-------
2065 lda $0314
2066 sta intrrp
2067 lda $0315
2068 sta intrrp+1
2070 lda #<irq
2080 sta $0314
2090 lda #>irq
2100 sta $0315
2110 cli
2120 rts
2130 irq asl seed ;---------
2140 bcc *+7
2150 lda #1
2160 sta seed
2170 lda irqflg
2180 bne *+5
2190 jmp $ea31
2200 jsr keybrd
2210 jmp $ea7e ;lda dc0d,restor reg,rti
2220 delay ldy #254 ;------
2230 b1 ldx #0
2240 inx
2250 bne *-1
2260 iny
2270 bne b1
2280 rts
2290 delay2 ldy #254 ;----
2300 inx
2310 bne *-1
2320 iny
2330 bne *-4
2340 rts
2350 print pla ;-----------
2360 sta msg+1 ;lobyte
2370 pla
2380 sta msg+2 ;hibyte
2390 inc msg+1
2400 bne msg
2410 inc msg+2
2420 msg lda $ffff ;temp dummy addr
2430 beq ajj ;end flag
2440 cmp #"_"
2450 bne *+4
2460 lda #13
2470 cmp #"@" ;alt. end flag
2480 beq ajj
2490 jsr $ffd2
2500 inc msg+1
2510 bne msg
2520 inc msg+2
2530 jmp msg
2540 ajj lda msg+2
2550 pha
2560 lda msg+1
2570 pha
2580 rts
2590 inkey lda #0 ;------
2600 sta $c6
2610 jsr $ffe4
2620 beq *-3
2630 rts
2640 keybrd jsr $ea87 ;-----
2650 stx $02 ;incase 13/abort
2660 cpx #"[145]"
2670 bne *+5
2680 jmp speedup
2690 cpx #""
2700 bne *+5
2710 jmp slowdn
2720 rts
2730 speedup lda delay+1 ;---------
2740 cmp #255
2750 beq *+6
2760 inc delay+1
2770 rts
2780 lda b1+1 ;'delay
2790 cmp #255
2800 beq *+5
2810 inc b1+1
2820 rts
2830 slowdn lda b1+1 ;------
2840 beq *+6
2850 dec b1+1
2860 rts
2870 lda delay+1
2880 beq *+5
2890 dec delay+1
2900 rts
2910 savepos sec ;------
2920 jsr $fff0 ;plot
2930 stx xpos
2940 sty ypos
2950 rts
2960 crsrup lda cntnumb ;------
2970 clc
2980 adc #2
2990 bcs *+5
3000 sta cntnumb
3010 jsr shownumb
3020 jmp kybd
3030 crsrdn lda cntnumb ;------
3040 sec
3050 sbc #2
3060 bcc *+5
3070 sta cntnumb
3080 jsr shownumb
3090 jmp kybd
3100 shownumb ldx xpos ;--------
3110 ldy ypos
3120 clc
3130 jsr $fff0
3140 jsr print :.byte 5
3150 .asc "    [157][157][157][157]@"
3160 ldx cntnumb ;x 32 = # of stars
3170 lda #0
3180 sta result
3190 sta result+1
3200 a3 lda result ;- -
3210 clc
3220 adc #32
3230 sta result
3240 bcc *+5
3250 inc result+1
3260 dex
3270 bne a3
3280 lda result+1
3290 ldx result
3300 jmp $bdcd
3310 ;----- data ------
3320 irqflg .byte 0
3330 moveflg .byte 0
3340 stkpntr .byte 0
3350 seed .byte 1
3360 mask .byte 0
3370 result .word 0
3380 xpos .byte 0
3390 ypos .byte 0
3400 cntnumb .byte 5
3410 cntdwn .byte 0
3420 onflg .byte 0
5000 qw0 sei
5001 lda intrrp
5002 sta $0314
5003 lda intrrp+1
5004 sta $0315
5005 cli
5008 lda #30
5010 ldy #>name
5020 ldx #<name
5030 jsr $ffbd;           setnam
5040 lda #15;             file number
5050 ldx #8
5060 ldy #15
5070 jsr $ffba;           setlfs
5080 jsr $ffc0;           open
5090 ldx #15
5100 jsr $ffc6;           set for input
5110 jsr $ffcf;           get byte
5120 sta knp
5130 jsr $ffcf
5140 sta knp+1
5150 ldy #0
5160 qw1 jsr $ffcf
5170 iny
5180 cpy #32
5190 bne qw1
5200 lda #15
5210 jsr $ffc3;         close 15
5220 jsr $ffcc;         clear channels
5230 ldx #255
5240 lda knp
5250 cmp #"6"
5260 bne nope
5270 lda knp+1
5280 cmp #"3"
5290 bne nope
5300 lda 53281
5310 sta 646
5320 ldy #0
5330 qw2 lda dyn,y
5340 jsr $ffd2
5350 beq qw3
5360 iny
5370 bne qw2
5380 qw3 lda #13
5390 sta 631
5400 sta 632
5410 sta 633
5420 lda #3
5430 sta 198
5440 rts
5450 nope lda #147
5460 jsr $ffd2
5470 rts
5480 name .asc "r0:hello connect=hello connect":.byt 0
5490 knp .byt 0,0
5500 dyn .byt 147,17,17,17
5510 .asc "load":.byt 34:.asc "hello connect"
5520 .byt 34:.asc ",8":.byt 13,17,17,17,17
5530 .asc "run":.byt 19,17,0
5535 intrrp .byte 0,0
5540 .end